home *** CD-ROM | disk | FTP | other *** search
Text File | 1994-09-19 | 3.5 KB | 159 lines | [TEXT/MWPS] |
- unit Counter1;
-
- interface
-
- uses
- LogicSimIntf;
-
- {In CodeWarrior Pascal the entry of the code resource is just after $MAIN}
- {In Think Pascal you would simply call the entry procedure "main" like that:}
- { procedure main(var blk: LSBlock) }
-
-
- {this project uses CodeWarrior...}
- {$MAIN}
-
- procedure ComponentProc (var blk: LSBlock);{Entry of the code ressource}
-
- implementation
-
- uses PascalA4;
-
-
- const
- CLASS_NAME = 'Counter1';
- PICT_ID = 128;
-
- type
- ClassDataR = record
- pic: PicHandle;
- end;
- ClassDataP = ^ClassDataR;
- ClassDataH = ^ClassDataP;
-
-
- GateDataR = record
- oldClock: SValue;
- value: SValue;
- end;
- GateDataP = ^GateDataR;
- GateDataH = ^GateDataP;
-
-
- procedure DoNewClass (var blk: LSBlock);
- {build a new class}
- var
- picH: Handle;
- err: OSErr;
- delaysP: DelaysPtr;
- begin
- picH := GetResource('PICT', PICT_ID);
- HNoPurge(picH);
- DetachResource(picH);{important because the file is going to be closed}
-
- blk.prm.prmClass^.image := Pointer(picH); {this picture is used in the list of components}
- blk.prm.prmClass^.name := CLASS_NAME;
- SetClassID(blk.prm.prmClass^.id, CLASS_NAME);
-
- delaysP := NIL; {default delays = (0,0,0,0,0,0) }
- LSDeclarePin(blk.env, blk.classRef, GetPoint(0,5), kInputPin, delaysP, 'T');
- LSDeclarePin(blk.env, blk.classRef, GetPoint(0,15), kInputPin, delaysP, 'CK');
- LSDeclarePin(blk.env, blk.classRef, GetPoint(50,5), kOutputPin, delaysP, 'OUT');
- LSDeclarePin(blk.env, blk.classRef, GetPoint(50,15), kOutputPin, delaysP, 'C');
-
- {the pins are numbered in the order used for their declaration}
- { so here T is pin #1, CK pin #2, OUT pin #3, C pin #4}
-
- SetHandleSize(Handle(blk.classData), sizeof(ClassDataR)); {prepare the class private storage}
- err := HandToHand(picH); {copy the picture}
- ClassDataH(blk.classData)^^.pic := Pointer(picH);
- end;
-
-
- procedure DoDraw (var blk: LSBlock);
- {draw the symbol of the component}
- begin
- DrawPicture(ClassDataH(blk.classData)^^.pic, blk.prm.prmSymbol^.frame);
- end;
-
- procedure DoNewGate (var blk: LSBlock);
- {create a new gate}
- begin
- SetHandleSize(Handle(blk.gateData), sizeof(GateDataR));
- end;
-
- procedure DoResetGate (var blk: LSBlock);
- {reset the gate internal values}
- var
- GDH: GateDataH;
- begin
- GDH := GateDataH(blk.gateData);
- GDH^^.oldClock := LX;
- GDH^^.value := L0;
- LSSetOutput(blk.env, blk.gateRef, 3, L0); {OUT}
- LSSetOutput(blk.env, blk.gateRef, 4, L0); {C}
- end;
-
- procedure DoSimulation (var blk: LSBlock);
- {set the values for all outputs}
- var
- T, CK, OUT, C: SValue;
- GDH: GateDataH;
- begin
- GDH := GateDataH(blk.gateData);
- LSGetInput(blk.env, blk.gateRef, 1, T);
- LSGetInput(blk.env, blk.gateRef, 2, CK);
- if PositiveEdge(GDH^^.oldClock,ck) & (T = L1) then
- GDH^^.value := LogicNOT(GDH^^.value);
- if (GDH^^.value = L1) & (T = L1) then C := L1 else C:= L0;
-
- LSSetOutput(blk.env, blk.gateRef, 3, GDH^^.value); {OUT}
- LSSetOutput(blk.env, blk.gateRef, 4, C); {C}
-
- GDH^^.oldClock := CK;
- end;
-
-
- procedure ComponentProc (var blk: LSBlock);
- var
- oldA4: longint;
- begin
-
- oldA4 := SetCurrentA4;
-
- {we need an A4 world for storing constant strings}
- {even if we have no real global variable}
-
- case blk.msg of
-
- { class messages}
-
- msgNewClass:
- DoNewClass(blk);
-
- msgDisposeClass:
- DisposeHandle(Handle(ClassDataH(blk.classData)^^.pic));
-
- {symbol messages}
-
- msgDrawSymbol:
- DoDraw(blk);
-
- {gate messages}
-
- msgNewGate:
- DoNewGate(blk);
-
- msgReset:
- DoResetGate(blk);
-
- msgSimulation:
- DoSimulation(blk);
-
- end;
-
- oldA4 := SetA4(oldA4);
- end;
-
-
- end.